;;to be used as a list to stored already generated strings
(defvar *guesses-made* nil)
(defvar *eligible-guesses* nil)
(defvar *max-eligible-size* 60)
(defvar *max-generations* 20)
(defvar *numberPerGeneration* 150)

(defvar *max-pop* nil)

;;==============================
;;  STRUCTURE (S) TO BE USED
;;==============================
;;to be stored in above list (gives more info than just string) 
(defstruct guessNode
  guess
  fitness
)

;;======================
;;  LIST FUNCTIONS
;;======================
(defun listToString ( list )
  (setq *guessString* "" )
  
  (loop for i from 1 to (length list)
    do
    (if (< i ( - (length list) 1) )
      (setq *guessString* (concatenate 'string *guessString* (string (nth i list)) ","))
      (setq *guessString* (concatenate 'string *guessString* (string (nth i list)) ))
    )
  )
  
  *guessString*
)


(defun APPEND-TO-LIST (element addList)
  (setq item nil)
  
  (if (listp element)
    (setq item element)
    (setq item (list element))
  )

  (if (NULL addList)
    (setq addList item)
    (nconc addList item)
  )
  addList
)

(defun APPEND-LIST-TO-LIST (element addList)
  (setq item nil)
  
  (if (listp element)
    (setq item (list element))
    (setq item (list (list element)))
  )

  (if (NULL addList)
    (setq addList item)
    (nconc addList item)
  )
  addList
)


;;======================
;;  FITNESS FUNCTIONS
;;======================
(defun calculateFitness (node numRed numWhite)
  ;(format t "Fitness~%")
  (if (NULL node)
    nil
    (setf (guessNode-fitness node)
      (+ (+ (* 2 numRed) numWhite) (sum-integers (+ numRed numWhite)))
    )
  )
  ;(format t "finished Fitness~%")
)

(defun makeFitness (guess actual colors)
  ;(FORMAT t "Actual: ~A~%" actual)
  ;(FORMAT t "Guess: ~A~%" guess)
  
  (if (not (listp guess)) (setq guess (guessNode-guess guess)) )
  
  (multiple-value-setq (fitness-red fitness-white) (mm-score guess actual colors t))
  
  (setq guessNode
    (make-guessNode :guess guess :fitness 0)
  )
  
  ;(FORMAT t "~A ~A~%" fitness-red fitness-white)
  
  (calculateFitness guessNode fitness-red fitness-white )

  guessNode
)


;;==========================
;;  VERIFICATION FUNCTIONS
;;==========================

(defun guessAlreadyMade (guess checkList)
;  (mem guess checkList)

  (setq doesExist nil)
  
  (mapcar
    (lambda (a)
      (if (listp a)
        (if (equal a guess)
          (setq doesExist t))
        (if (equal (guessNode-guess a) guess)
          (setq doesExist t))    
      )
    ) checkList
  )
  
  doesExist
)

(defun guessNodeEqual (n1 n2)
  (AND (EQUAL (guessNode-guess n1) (guessNode-guess n2))
       (EQ (guessNode-fitness n1) (guessNode-fitness n2)))
)


(defun isEligible (guess colors)
  ;(FORMAT t "Eligible Start~%")
  
  ;(FORMAT t "new-guess: ~A~%" guess)
  
  (if (listp guess)
    (setq *new-guess* guess )
    (setq *new-guess* (guessNode-guess guess) )
  )
  
  ;(FORMAT t "new-guess: ~A~%" *new-guess*)
  
  (setq eligible nil)
  
  (setq numValid 0)
  (setq numGuessNodes (list-length *guesses-made* ))
  
  (mapcar
    (lambda (a)
      (progn
        (setq testNode (makeFitness (guessNode-guess a) *new-guess* colors))
        (if (guessNodeEqual testNode a) (setq numValid (+ numValid 1)) )
        ;(setq testNode nil)
      )
    ) *guesses-made*
  )
  
  (if (EQ numValid numGuessNodes)
    (setq eligible 1)
  )
  
  ;(FORMAT t "Eligible: ~A~%" eligible)
  
  eligible
)


;;==========================
;;  POPULATION FUNCTIONS
;;==========================
(defun one-point-crossover (x y)
  (setq n (list-length x))
  (setq c (random n ) )
  (setq child nil)
  
  (loop for i from 0 to (- n 1)
    do (progn
      (if (<= i c)
        (setq child (APPEND-TO-LIST (nth i x) child))
        (setq child (APPEND-TO-LIST (nth i y) child))
      )
    )
  )
  
  child
)

(defun two-point-crossover (x y )
  (setq n (list-length x)) (setq child nil)
  (setq pos1 (random n ) ) (setq pos2 (random n ) )
  (setq posA 0) (setq posB 0)
  
  (if (> pos1 pos2)
    (progn (setq posA pos2) (setq posB pos1) )
    (progn (setq posA pos1) (setq posB pos2) )
  )
  
  (setq before nil) (setq between nil) (setq after nil)
  
  (loop for i from 0 to (- n 1)
    do
      (cond
        ((< i posA)
          (setq before (APPEND-TO-LIST (nth i x) before) )
        )
        ((> i posB)
          (setq after (APPEND-TO-LIST (nth i x) after ))
        )
        ( t (setq between (APPEND-TO-LIST (nth i y) between )))
      )
  )
  
  (setq child (APPEND-TO-LIST between before ))
  (setq child (APPEND-TO-LIST after child ))
  
  child
)


;replaces the color of one chosen position
;;with a random other color.
(defun mutation (guess pos colorList)
  (setf (nth pos guess) (nth (random (list-length colorList)) colorList))
  guess
)

;;the colors of two positions are switched.
(defun permutation (guess pos1 pos2)
  ;(FORMAT t "Permutation~%")
  (setq item1 (nth pos1 guess) )
  (setq item2 (nth pos2 guess) )
  
  (setf (nth pos1 guess) item2)
  (setf (nth pos2 guess) item1)
  
  guess
)

;the sequence of colors between two given positions is inverted.
(defun inversion (child pos1 pos2 )
  ;(FORMAT t"Inversion~%")
  (setq posA 0) (setq posB 0)
  
  (if (> pos1 pos2)
    (progn (setq posA pos2) (setq posB pos1) )
    (progn (setq posA pos1) (setq posB pos2) )
  )
  
  (setq before nil) (setq between nil) (setq after nil)
  
  (loop for i from 0 to (- (list-length child) 1)
    do
      (cond
        ((< i posA)
          (setq before (APPEND-TO-LIST (nth i child) before) )
        )
        ((> i posB)
          (setq after (APPEND-TO-LIST (nth i child) after ))
        )
        ( t (setq between (APPEND-TO-LIST (nth i child) between )))
      )
  )
  
  (setq newList (APPEND-TO-LIST (reverse between) before ))
  
  (if (not (NULL after))
    (setq newList (APPEND-TO-LIST after newList ))
  )
  
  newList
)


;;==========================
;;  GUESS FUNCTIONS
;;==========================

(defun uniqueRandGuess (numPegs colorList)
  (if (EQ (list-length *alrdy-gen*) *max-pop*)
    nil
    (progn
      (setq *new-guess* 
        ( loop for i from 1 to numPegs
          collect (nth (random (length colorList)) colorList)
        )
      )
      
      (if (guessAlreadyMade *new-guess* *ALRDY-GEN*)
        (progn
          (setq *new-guess* nil)
          (setq *new-guess* (uniqueRandGuess numPegs colorList)) 
        )
        ;(setq *alrdy-gen* (APPEND-LIST-TO-LIST *new-guess* *alrdy-gen*))
      )
      
      *new-guess* 
    )
  )
)

(defun GA (*prev-gen* numPegs colorList)
  (setq child nil)
  
  (if (OR (EQ (list-length *alrdy-gen*) *max-pop*) (<= (list-length *prev-gen*) 0))
    nil
    (progn
      (if (<= (list-length *prev-gen*) 1) nil
      
        (progn 
          (setq parent1 (nth (random (list-length *prev-gen*)) *prev-gen*) )
          (setq parent2 (nth (random (list-length *prev-gen*)) *prev-gen*) )
          
          (if (> (random 2) 0)
            (setq child (one-point-crossover parent1 parent2))
            (setq child (two-point-crossover parent1 parent2))
          )
          
          (if (< (random 100) 3) (setq child (mutation child (random numPegs) colorList)) )
          (if (< (random 100) 3) (setq child (permutation child (random numPegs) (random numPegs) )) )
          (if (< (random 100) 2) (setq child (inversion child (random numPegs) (random numPegs) )) )
        )
      )
      ;(if (guessAlreadyMade child *alrdy-gen*)
      ;  (progn
      ;    (setq child nil)
      ;    (setq child (GA *prev-gen* numPegs colorList))
      ;  )      
      ;  (setq *alrdy-gen* (APPEND-LIST-TO-LIST child *alrdy-gen*))
      ;)
    )
    
  )
  
  child
)

(defun radu-rosu (numPegs colorList)
  (setq *new-guess* (uniqueRandGuess numPegs colorList))
  
  (loop while (not (isEligible *new-guess* colorList) )
    do (progn
;      (FORMAT t "_")
      (setq *new-guess* (uniqueRandGuess numPegs colorList) )
    )
  )
  (FORMAT t "~%")
  
  *new-guess* 
)


(defun trio (numPegs colorList)
  (setq *new-guess* (uniqueRandGuess numPegs colorList))
  (setq h 1) ;;where h is the current generation
  
  (setq *prev-gen* (initPopulation numPegs colorList *numberPerGeneration*) )
  (setq *prev-gen* (remove nil *prev-gen* ))
  
  ;(FORMAT t "finished *prev-gen*: ~A~%" (list-length *prev-gen*) )
  ;(FORMAT t "Start loop~%")
  
  (loop while (AND (<= (list-length *eligible-guesses*) *max-pop*)
              (AND (<= h *max-generations*)
                   ( <= (list-length *eligible-guesses*) *max-eligible-size* ) ))
    do
      (progn
        (setq *curr-gen* nil) (setq i 0)
        
        (loop while (< i (- *numberPerGeneration* 1) )
          do (progn
          
            (setq child (GA *prev-gen* numPegs colorList))
            ;(FORMAT t "Child: ~A~%" child)

            ;(FORMATt "^")
            
            (if (not (null child))
              (progn
                (if (AND (isEligible child colorList) (NOT (guessAlreadyMade child *eligible-guesses*)))
                  (progn
                    (setq guessNode (make-guessNode :guess child :fitness 0) )
                    (setq *eligible-guesses* (APPEND-TO-LIST guessNode *eligible-guesses*) )
                    (setq *curr-gen* (APPEND-LIST-TO-LIST child *curr-gen*) )
                    ;(FORMATt "@")
                  )
                )
              )
            )
            
            (setq i (+ i 1))
            ;(FORMATt "|")
          )
        )
        
        ;(FORMAT t "finished current generation ~%")
        (setq *prev-gen* *curr-gen*)
            
        (if (EQ (list-length *curr-gen*) 0)
          (setq h (+ *max-generations* 1) )
          (setq h (+ h 1))
        )
            
        ;(FORMAT t "h: ~A~%" h)
    )
  )
  
  ;(FORMAT t "Before: ~A~%" (list-length *eligible-guesses*) )
  
  (setq varsToBeRemoved nil)
  
  (mapcar
    (lambda (a)
      (progn
        ;(FORMAT t "node: ~A~%" a)
        (setq b (guessNode-guess a))
        
        (if (NOT (isEligible b colorList) )
          (setq varsToBeRemoved (APPEND-To-list a varsToBeRemoved) )
        )
      )
    ) *eligible-guesses*
  )
  
  (loop for i from 0 to (list-length varsToBeRemoved)
    do (setq *eligible-guesses* (remove (nth i varsToBeRemoved) *eligible-guesses*))
  )
  
  ;(FORMATt "After: ~A~%" (list-length *eligible-guesses*) )
  ;(FORMATt "Max-Pop: ~A~%" *max-pop* )
  ;(FORMATt "Alrdy-gen-size: ~A~%" (list-length *alrdy-gen*) )
    
  (if (EQ (list-length *eligible-guesses*) 0)
    (setq *new-guess* ( UNIQUERANDGUESS numPegs colorList) )
    
    (progn
      (setq rand-pos (random (list-length *eligible-guesses*) ))
      (setq *new-guess* (guessNode-guess (nth rand-pos *eligible-guesses*) ))
      (setq *eligible-guesses* (delete-pos rand-pos *eligible-guesses* ))
    )
  )
  
  ;(FORMAT t "~A~%" (list-length *guesses-made*) )
  
  (setq *prev-gen* nil)
  (setq *curr-gen* nil)
  
  *new-guess* 
)


(defun initPopulation (numPegs colorList newPopSize)
  (setq newPop nil)
  
  ;(FORMATt "Start initpop~%")
  
  (loop for i from 0 to (- newPopSize 1)
    do
      (progn
        (setq *new-guess* (uniqueRandGuess numPegs colorList))
        ;(FORMATt "*")
        
        (if (NULL *new-guess*)
          nil
          (progn
            (if (AND (isEligible *new-guess* colorList) (NOT (guessAlreadyMade *new-guess* *eligible-guesses*)) )
              (progn
                (setq guessNode (make-guessNode :guess *new-guess* :fitness 0) )
                (setq *eligible-guesses* (APPEND-TO-LIST guessNode *ELIGIBLE-GUESSES*) )
              )
            )
            (setq newPop (APPEND-LIST-TO-LIST *new-guess* newPop))
          )
        )
      )
  )
  
  ;(FORMATt "End initpop~%")
  
  newPop
)


(defun delete-pos (n list) 
  (if (zerop n) 
      (cdr list) 
    (let ((cons (nthcdr (1- n) list))) 
      (when cons 
        (setf (cdr cons) (cddr cons))) 
      list)))
      
 (defun sum-integers (n)
	(* (1+ n) n 1/2))

(defun mem (E L)
  (if (null L)
    nil
    (if (equal (first L) E)
      T
      (mem E (rest L))
    )
  )
)
